home *** CD-ROM | disk | FTP | other *** search
/ CD Actual 3 / CD ACTUAL 3.iso / linux / system / bsvc-1.000 / bsvc-1 / bsvc-1.0.4 / src / UI / help.tk < prev    next >
Encoding:
Tcl/Tk script  |  1995-07-26  |  6.1 KB  |  189 lines
  1. #!/usr/local/bin/wish -f
  2. ###############################################################################
  3. # $Id: help.tk,v 1.3 1995/06/29 22:42:23 bmott Exp $
  4. ###############################################################################
  5. #
  6. # HelpMe - A hype-text help facility for Tcl/Tk.
  7. #
  8. # By: Bradford W. Mott   October 5,1993
  9. #
  10. # Imbedded Usage:  HelpMe { filename top_node widget_name window_name }
  11. #                           filename    - help file to display
  12. #                           widget_name - help's widget base name
  13. #                           window_name - window managers name
  14. ###############################################################################
  15. # $Log: help.tk,v $
  16. # Revision 1.3  1995/06/29  22:42:23  bmott
  17. # Changed font resources
  18. #
  19. # Revision 1.2  1995/01/01  03:03:19  bmott
  20. # Changed ToNode highlight and took out the Top button
  21. #
  22. # Revision 1.1  1994/02/18  20:29:13  bmott
  23. # Initial revision
  24. #
  25. ###############################################################################
  26.  
  27. proc NOP {} {}
  28.  
  29. proc PreviousNode {w stackvar info} {
  30.   global $stackvar
  31.  
  32.   eval "set stack \$$stackvar"
  33.   if {[llength $stack] != 1} {
  34.     set new_stack "[lrange $stack 0 [expr [llength $stack]-2]]"
  35.     eval "set $stackvar \"$new_stack\""
  36.  
  37.     set node "[lindex $new_stack [expr [llength $new_stack]-1]]"
  38.     display_node "$node" $info $w
  39.   }
  40. }
  41.  
  42. proc RemoveHigh {w} {
  43.   $w tag remove ToNodeHigh 1.0 end
  44. }
  45.  
  46. proc AddHigh { x y w} {
  47.   set range [$w tag nextrange ToNodeTag "@$x,$y linestart" "@$x,$y lineend"]
  48.   while {1} {
  49.     if {[$w compare "@$x,$y" >= [lindex $range 0]] && \
  50.         [$w compare "@$x,$y" <= [lindex $range 1]]} {
  51.       $w tag remove ToNodeHigh 1.0 end
  52.       $w tag add ToNodeHigh [lindex $range 0] [lindex $range 1]
  53.       break;
  54.     } else {
  55.       set range [$w tag nextrange ToNodeTag [lindex $range 1] "@$x,$y lineend"]
  56.     }
  57.   } 
  58. }
  59.  
  60. proc ToNodeBind { x y w info stackvar} {
  61.   global $stackvar
  62.  
  63.   set range [$w tag nextrange ToNodeTag "@$x,$y linestart" "@$x,$y lineend"]
  64.   while {1} {
  65.     if {[$w compare "@$x,$y" >= [lindex $range 0]] && \
  66.         [$w compare "@$x,$y" <= [lindex $range 1]]} {
  67.       eval "lappend $stackvar \"[$w get [lindex $range 0] [lindex $range 1]]\""
  68.       display_node [$w get [lindex $range 0] [lindex $range 1]] $info $w
  69.       break
  70.     } else {
  71.       set range [$w tag nextrange ToNodeTag [lindex $range 1] "@$x,$y lineend"]
  72.     }
  73.   } 
  74. }
  75.  
  76. ###############################################################################
  77. # This routine parses a line and displays it in the text widget
  78. ###############################################################################
  79. proc add_node_text { line w } {
  80.   while {1} {
  81.     set first [string first "#" $line]
  82.     if {$first != 0} {
  83.       if {$first > 0} {
  84.         set arg [string range $line 0 [expr $first-1]]
  85.         set line [string range $line $first end]
  86.         $w insert end $arg
  87.         $w tag remove NodeTag "end - [string length $arg] chars" "end"
  88.         $w tag remove ToNodeTag "end - [string length $arg] chars" "end"
  89.       } else {
  90.         $w insert end $line\n
  91.         $w tag remove NodeTag "end - [expr [string length $line]+1] chars" \
  92.                               "end"
  93.         $w tag remove ToNodeTag "end - [expr [string length $line]+1] chars" \
  94.                               "end"
  95.         break;
  96.       }
  97.     } else {
  98.       set last [string first ">" $line]
  99.       if {$last == -1} {
  100.       } else {
  101.         set command [string range $line $first $last]
  102.         set arg [string range $command [expr [string first "<" $command]+1] \
  103.                 [expr $last-1]]
  104.         set line [string range $line [expr $last+1] end]
  105.  
  106.         if {[regexp {^#Node<} $command] == 1} {
  107.           $w insert end $arg
  108.           $w tag add NodeTag "end - [string length $arg] chars" "end"
  109.         }
  110.         if {[regexp {^#ToNode<} $command] == 1} {
  111.           $w insert end $arg
  112.           $w tag add ToNodeTag "end - [string length $arg] chars" "end"
  113.         }
  114.       }
  115.     }
  116.   } 
  117. }
  118.  
  119. proc display_node { node info w } {
  120.   $w delete 0.0 end
  121.   set start [lsearch -regexp $info "#Node<$node>"]
  122.   set end [lsearch -regexp $info "#NodeEnd<$node>"]
  123.   set node_text [lrange $info $start $end]
  124.   foreach i $node_text {add_node_text $i $w}
  125. }
  126.  
  127. proc HelpMe { filename w name } {
  128.   set stackname [string range $w 1 end]_global_stack
  129.   global $stackname
  130.  
  131.   catch {destroy $w}
  132.   toplevel $w
  133.   wm title $w "$name"
  134.   wm iconname $w "$name"
  135.  
  136.   set file [open $filename {r}]
  137.   set info [read $file]
  138.   close $file
  139.   set info [split $info \n]
  140.  
  141.   ## Find the top level node
  142.   foreach i $info {
  143.     if {[regexp {^#TopLevelNode<} $i] == 1} {
  144.       set top_node [string range $i [expr [string first "<" $i]+1] \
  145.           [expr [string first ">" $i]-1]]
  146.       break
  147.     }
  148.   }
  149.  
  150.   text $w.helpText -cursor left_ptr -yscrollcommand "$w.scroll set"
  151.   bind $w.helpText <Any-KeyPress> "NOP"
  152.   bind $w.helpText <Any-ButtonPress> "NOP"
  153.   bind $w.helpText <Any-Motion> "NOP"
  154.   bind $w.helpText <Any-Double-ButtonPress> "NOP"
  155.  
  156.   scrollbar $w.scroll -relief raised \
  157.       -command "$w.helpText yview"
  158.      
  159.   frame $w.buttons -borderwidth 2 -relief sunken
  160.     button $w.buttons.previous -text "Previous" \
  161.         -command "PreviousNode $w.helpText $stackname {$info}"
  162.     button $w.buttons.dismiss -text "Dismiss" \
  163.         -command "destroy $w"
  164.     pack $w.buttons.previous -side left -fill x -expand 1 -padx 8 -pady 2
  165.     pack $w.buttons.dismiss -side left -fill x -expand 1 -padx 8 -pady 2
  166.  
  167.   pack $w.buttons -side bottom -fill x -expand 1
  168.   pack $w.scroll -side left -fill y -expand 1
  169.   pack $w.helpText -side left -fill both -expand 1 -padx 4
  170.  
  171.   $w.helpText tag configure NodeTag -font -*-helvetica-medium-o-normal--*-180-*-*-*-*-iso8859-* \
  172.       -underline 1 -foreground Red
  173.   $w.helpText tag configure ToNodeTag -underline 1
  174.   $w.helpText tag configure ToNodeHigh -background White
  175.   $w.helpText tag bind ToNodeTag <Button-1> \
  176.       "ToNodeBind %x %y $w.helpText {$info} $stackname"
  177.   $w.helpText tag bind ToNodeTag <Any-Enter> \
  178.       "AddHigh %x %y $w.helpText"
  179.   $w.helpText tag bind ToNodeTag <Any-Leave> \
  180.       "RemoveHigh $w.helpText"
  181.  
  182.   ## Setup the stack
  183.   eval "set $stackname \"\"" 
  184.   eval "lappend $stackname \"$top_node\""
  185.  
  186.   display_node $top_node $info $w.helpText
  187. }
  188.  
  189.